home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / old-fut.em < prev    next >
Lisp/Scheme  |  1992-10-06  |  4KB  |  127 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;                                                                           ;;
  9. ;;   EuLisp Module  -   Copyright (C) Codemist and University of Bath 1989   ;;
  10. ;;                                                                           ;;
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ;;                                                                           ;;
  15. ;; Name: futures                                                             ;;
  16. ;;                                                                           ;;
  17. ;; Author: Keith Playford                                                    ;;
  18. ;;                                                                           ;;
  19. ;; Date: 20 May 1990                                                         ;;
  20. ;;                                                                           ;;
  21. ;; Description: Eager evaluating futures using the EuLisp thread mechanism   ;;
  22. ;;                                                                           ;;
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24.  
  25. ;;
  26.  
  27. ;; Change Log:
  28. ;;   Version 1.0 (20/5/90)
  29.  
  30. ;;
  31.  
  32. (defmodule futures
  33.  
  34.   (standard0) ()
  35.  
  36.   ;;
  37.   ;; Book-keeping...
  38.   ;;
  39.  
  40.   (deflocal future-count-value 0)
  41.  
  42.   (defun future-count () future-count-value)
  43.   (defun set-future-count (n) (setq future-count-value n))
  44.   ((setter setter) future-count set-future-count)
  45.  
  46.   (defun increment-future-count () 
  47.     (setq future-count-value (+ future-count-value 1)))
  48.  
  49.   (defun zero-future-count () (setq future-count-value 0))
  50.  
  51.   (export future-count set-future-count 
  52.           increment-future-count zero-future-count)
  53.  
  54.   ;;
  55.   ;; Future structure...
  56.   ;;
  57.  
  58.   (defstruct future-object ()
  59.     ((function 
  60.         accessor future-object-function)
  61.      (thread 
  62.         accessor future-object-thread)
  63.      (value 
  64.         accessor future-object-value)
  65.      (done  
  66.         initform nil
  67.     accessor future-object-done))
  68.     constructor make-future-object)
  69.  
  70.   (export future-object future-object-value future-object-function
  71.       future-object-done make-future-object future-object-thread)
  72.  
  73.   ;;
  74.   ;; Predicate...
  75.   ;;
  76.  
  77.   (defgeneric futurep (obj))
  78.  
  79.   (defmethod futurep ((obj object)) nil)
  80.   (defmethod futurep ((f future-object)) t)
  81.  
  82.   (export futurep)
  83.  
  84.   ;;
  85.   ;; Future macro...
  86.   ;;
  87.  
  88.   (defmacro future exp
  89.     `(let 
  90.        ((@@future@@ (make-future-object))
  91.     (@@task@@ (make-thread 
  92.                 (lambda (future fun)
  93.               ((setter future-object-value) future (fun))
  94.               ((setter future-object-done) future t)
  95.               t))))
  96.          ((setter future-object-thread) @@future@@ @@task@@)
  97.         ((setter future-object-function) @@future@@ (lambda () ,@exp))
  98.      (thread-start @@task@@ @@future@@ (lambda () ,@exp)) 
  99.      (increment-future-count)
  100.      @@future@@))
  101.        
  102.   (export future)
  103.  
  104.   ;;
  105.   ;; Evaluator...
  106.   ;;
  107.  
  108.   (defun futureeval (fut)
  109.     (if (futurep fut)
  110.     (if (future-object-done fut) (futureeval (future-object-value fut))
  111.       (progn
  112.         (thread-value (future-object-thread fut))
  113.         (futureeval fut)))
  114.     fut))
  115.     
  116.   (export futureeval)                  
  117.  
  118.   ;;
  119.   ;; Test...
  120.   ;;
  121.      
  122.   (defun future-done-p (fut) (future-object-done fut))
  123.  
  124.   (export future-done-p)
  125.  
  126. )
  127.